home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 5 / Skunkware 5.iso / bin / xpstat < prev    next >
Text File  |  1995-07-21  |  6KB  |  263 lines
  1. #!/usr/skunk/bin/expectk -f
  2.  
  3. # This script acts as a front-end for xpilot.  Run it in the background,
  4. # and it will pop up a window for each server it finds running.  After
  5. # you run it, press the "?" button for more info.
  6.  
  7. # Store the filename of your xpilot client in the following variable.
  8. set xpilot ~bodarky/src/xpilot-2.0beta/src/xpilot
  9.  
  10. # Author: Don Libes, NIST, 12/29/92
  11.  
  12. # I never have figured out how to get the alias out of xrdb.  For now, just
  13. # read it ourselves out of .Xdefaults - ugh.
  14.  
  15. log_user 0
  16.  
  17. set timeout 60
  18.  
  19. proc probe {} {
  20.     global max db hosts world
  21.  
  22.     set timeout -1
  23.  
  24.     expect_before eof {wait;return 0}
  25.  
  26.     expect -re "Server on (\[^\\.]*). Enter command> " {
  27.             exp_send "S\r"
  28.             set host $expect_out(1,string)
  29.             lappend hosts $host
  30.     }
  31.     expect -re "WORLD\[^:]*: (\[^\r]*)\r" {
  32.         set worldtmp $expect_out(1,string)
  33.     }
  34.     expect -re "AUTHOR\[^:]*: (\[^\r]*)\r" {
  35.         set author $expect_out(1,string)
  36.     }
  37.     set world($host) "$worldtmp by $author"
  38.  
  39.     # skip over junk to get players
  40.     expect {
  41.         -re -+ {}
  42.         -re "Enter command> " {
  43.             set max($host) 0
  44.             display $host
  45.             return 1
  46.         }
  47.     }
  48.     set i 0
  49.     expect {
  50.         -re "\\.\\.\\. .  (................)   (...) *(\[^ ]*) *(\[^\r]*)\r" {
  51.             # strip trailing blanks
  52.             set alias [string trimright $expect_out(1,string)]
  53.             set db($host,$i,alias) $alias
  54.             
  55.             # strip leading zeros
  56.             scan $expect_out(2,string) %d db($host,$i,life)
  57.  
  58.             set db($host,$i,score) $expect_out(3,string)
  59.  
  60.             set db($host,name,$alias) $expect_out(4,string)
  61.  
  62.             incr i
  63.             exp_continue
  64.         }
  65.         -re "Enter command>"
  66.  
  67.     }
  68.     set max($host) $i
  69.     display $host
  70.  
  71.     return 1
  72. }
  73.  
  74. proc resize {w a b c d} {
  75.     # 27 is a guess at a fixed-width sufficiently comfortable for
  76.     # the variable-width font.  I don't know how to do better.
  77.     $w configure -geometry 27x$a
  78. }
  79.  
  80. proc play {host} {
  81.     global xpilot alias
  82.  
  83.     exec xhost $host
  84.     catch {exec $xpilot -name $alias($host) -join $host} status
  85. }
  86.  
  87. proc show-help {x y msg} {
  88.     catch {destroy .help}
  89.     toplevel .help
  90.     wm geometry .help +$x+$y
  91.  
  92.     message .help.text -text $msg
  93.  
  94.     button .help.ok -text "ok" -command {destroy .help}
  95.     pack append .help .help.text {top} .help.ok {top fill}
  96. }
  97.  
  98. # pop up window with alias
  99. proc show-alias {host seln x y} {
  100.     global db
  101.  
  102.     catch {destroy .alias}
  103.     toplevel .alias
  104.     wm geometry .alias +$x+$y
  105.     wm transient .alias .
  106.  
  107.     # selns with embedded space are wrapped w/extra {}s
  108.     # if [scan $seln \{%\[^\}\] tmp] {set alias $tmp}
  109.     regexp "\{(.*\[^ ]) +\[-0-9]+ +\[0-9]+\}$" $seln discard alias
  110.  
  111.     button .alias.b -text "$db($host,name,$alias)" -command {
  112.         destroy .alias
  113.     }
  114.     pack append .alias .alias.b top
  115. }
  116.  
  117. proc help {x y} {
  118.     show-help $x $y "xpstat - written by Don Libes, NIST, December 29, 1992
  119.  
  120. This script acts as a front-end for xpilot.  Run it in the background, and it will pop up a window for each server it finds running.  Press the \"?\" button for this info.
  121.  
  122. This program polls each xpilot server once a minute.  To make it poll immediately, press \"update\".  Press \"play as\" to enter the current game with the alias to the right.  Edit to taste.  (Your alias is initialized from the value of xpilot.name in ~/.Xdefaults.)
  123.  
  124. Double-click the left button on an alias to see the real user name.  To remove the user name window, click on it with the left button.
  125.  
  126. Pan the world/author text, player list, or your own alias by holding the middle mouse button down and moving the mouse."
  127. }
  128.  
  129. # if user presses "update" try to update screen immediately
  130. proc prod {x y} {
  131.     global cat_spawn_id updateflag
  132.  
  133.     if $updateflag {
  134.         show-help $x $y "I heard you, gimme a break.  I'm waiting for the xpilot server to respond..."
  135.     }
  136.     set updateflag 1
  137.  
  138.     exp_send -i $cat_spawn_id "\r"
  139. }
  140.  
  141. proc display {host} {
  142.     global world db alias max env
  143.  
  144.     set w .$host
  145.     #if 0==[llength [info com $w]]
  146.     if ![winfo exists $w] {    
  147.  
  148.         # window does not exist, create it
  149.  
  150.         toplevel $w -class xpstat
  151.         wm minsize $w 1 1
  152.         wm title $w "xpilot@$host"
  153.         wm iconname $w "$host xpilot stats"
  154.         entry $w.world -state disabled -textvar world($host)
  155.         listbox $w.players -yscroll "resize $w.players" -geometry 1x1 \
  156.             -font 7x13bold
  157.         bind $w.players <Double-Button-1> {
  158.             scan %W ".%%\[^.]" host
  159.             show-alias $host [selection get] %X %Y
  160.         }
  161.  
  162.         message $w.msg -text "no players" -aspect 1000 -justify center
  163.  
  164.         button $w.help -text ? -command {
  165.             help 10 20
  166.         }
  167.  
  168.         button $w.update -text "update"
  169. #        bind $w.update +<1> {send_user "button down\n"}
  170.         bind $w.update <ButtonRelease-1> {
  171.             prod %X %Y
  172.             tk_butUp %W
  173.         }
  174.  
  175.         button $w.play -text "play as"
  176.         bind $w.play <ButtonRelease-1> {
  177.             scan %W ".%%\[^.]" host
  178.             play $host
  179.             tk_butUp %W
  180.         }
  181.  
  182.         entry $w.alias -textvar alias($host) -width 10
  183.         set alias($host) $env(USER)
  184.  
  185.         bind $w.alias <Return> {
  186.             scan %W ".%%\[^.]" host
  187.             play $host
  188.         }
  189.  
  190.         pack append $w $w.world {top fill} \
  191.             $w.msg {top fill} \
  192.             $w.help {left} \
  193.             $w.update {left} \
  194.             $w.play {left} \
  195.             $w.alias {left}
  196.         set max($host,was) 0
  197.     }
  198.  
  199.     if $max($host)==0 {
  200.         # put up "no players" message?
  201.         if $max($host,was)>0 {
  202.             pack after $w.world $w.msg {top fill}
  203.             pack unpack $w.world
  204.         }
  205.     } else {
  206.         # remove "no players" message?
  207.         if $max($host,was)==0 {
  208.             pack after $w.world $w.players {top}
  209.             pack unpack $w.msg
  210.         }
  211.     }        
  212.  
  213.     $w.players delete 0 end
  214.  
  215.     for {set i 0} {$i<$max($host)} {incr i} {
  216.         $w.players insert end [format "%-17s %4d %d" \
  217.             $db($host,$i,alias) \
  218.             $db($host,$i,score) \
  219.             $db($host,$i,life) \
  220.                     ]
  221.     }
  222.  
  223.     set max($host,was) $max($host)
  224. }
  225.  
  226. wm withdraw .
  227. set oldhosts {}
  228.  
  229. set updateflag 0        ;# 1 if user pressed "update" button
  230.  
  231. # look for desired alias in the .Xdefaults file
  232. set status [catch {exec egrep "xpilot.name:" [glob ~/.Xdefaults]} output]
  233. if $status==0 {
  234.     regexp "xpilot.name:\[ \t]*(\[^\r]*)" $output dummy env(USER)
  235. }
  236.  
  237. spawn cat -u; set cat_spawn_id $spawn_id
  238.  
  239. while 1 {
  240.     global xpilot hosts
  241.  
  242.     set hosts {}
  243.  
  244.     spawn $xpilot
  245.     while {[probe]} {exp_send "N\r"}
  246.     expect_before    ;# disable expect_before from inside probe
  247.  
  248.     # clean up hosts that no longer are running xpilots
  249.  
  250.     foreach host $oldhosts {
  251.         # if host not in hosts
  252.         if -1==[lsearch $hosts $host] {
  253.             destroy .$host
  254.         }
  255.     }
  256.     set oldhosts $hosts
  257.  
  258.     set updateflag 0
  259.  
  260.     # sleep for a little while, subject to click from "update" button
  261.     expect -i $cat_spawn_id -re "...."    ;# two crlfs
  262. }
  263.